COMMENT ⊗   VALID 00021 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART
C00005 00003	
C00008 00004	SUBR(WITH3D,FACE,X,Y,Z)		TEST FOR LOCUS WITHIN FACE 3D.
C00011 00005	SUBR(COMPFE,FACE,EDGE)		COMPARE FACE EDGE 3D FOR PIERCING.
C00014 00006	SUBN(OTHERV,FACE,VERTEX)	FETCH OTHER VERTEX PIERCING FACE.
C00018 00007	SUBN(SOLANG,VERTEX)	DIUHEDRAL ANGLE AT A PIERCING VERTEX.
C00029 00008	SUBN(KLSURV,B)		KILL SURFACE VERTICES OF A BODY.
C00032 00009	SUBR(BIN,B1,B2)		COMPUTE BODY OF INTERSECTION.
C00036 00010	SUBN(MKSURF,VERTEX)	MAKE SURFACE EDGES AND VERTICES.
C00041 00011	SUBN(FIXUP1)
C00044 00012	SUBN(QHOLE,VERTEX)	 DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00046 00013	SUBR(MKCVEX)F 		MAKE CONVEX.
C00049 00014		GO L6
C00051 00015	SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00053 00016	SUBR(ESLURP,BODY)	REMOVE UNNECESSARY EDGES.
C00056 00017	SUBR(MKBUCK,BODY)		MAKE BUCKET CUBE.
C00058 00018	SUBR(ECUT,B,DX,DY,DZ)
C00061 00019	SUBR(BCUT,B,DX,DY,DZ)
C00066 00020	SUBN(FECUT,BODY)	    FACE EDGE CUTTING.
C00069 00021	
C00071 ENDMK
C⊗;
TITLE BIN - BODY INTERSECTION - 7 MARCH 1973 - B.G.BAUMGART

	EXTERN VCW,VCCW,ECCW,VERIFY
	EXTERN FACOEF,ESPLIT,INVERT
	EXTERN GLUEE,LINKED,MKEV,MKFE

	EXTERN MKB,MKF,MKE,MKV,MKFRAME,WING
	EXTERN OTHER,EVERT,FCCW,FCW
	EXTERN DPYBUF,DPYSET,DPYOUT

	EXTERN QFEV,KLFE,ECOEF,ECW

	↓SURBIT←←1B2	;VERTEX ON SURFACE.
	↓OKBIT←←2B2

	DEFINE QFACE(Q,V){CDR Q,7(V)}
	DEFINE QFACE.(Q,V){DAP Q,7(V)}

	DEFINE NAF (Q,E){CAR Q,-1(E)}
	DEFINE NAF.(Q,E){DIP Q,-1(E)}

	DEFINE PAF (Q,E){CDR Q,-1(E)}
	DEFINE PAF.(Q,E){DAP Q,-1(E)}

	DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
	DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
	MOVSI XWC(V)↔HRRI XWC(V.)↔BLT ZWC(V.)}

	DECLARE{FNEXT,ENEXT}
	↓PZ ←←1B28
	↓NZ ←←1B29
COMMENT/

	Although this code performs body union and body  subtraction;
all  the  nomensclature  will  be in terms of body intersection, BIN.
Pure BIN takes two operand bodies and "copies" off them  a  resultant
body  of their intersection. This requires marking and splitting some
of faces and edges, however the operand bodies  can  be  restored  to
their  original  selves by applying KLTMPS; or if the operands are no
longer needed they must be explicitly killed.

1. Face-Edge Compare; Make piercing vertices.

	All the faces of each operand is compared with all the edges
of the other. When a edge passes thru a face, the edge is spilt and
a "surface vertex" or "SURV" is placed at the piercing point. The
QFACE of the SURV points at the face pierce.

2. Face Hole Suppression.

3. Body and Face Tracing.

4. Dealing with bodies of parts.

5. Convex face making.


LINKS LEFT BY BIN.

	ALT  of  all result vertices points to a vertex in one or the
other operand. ALT of a result edge is zero, if the edge  was  formed
by  two  conflicting  faces in the operands, the particular faces are
pointed at by the NAF and PAF links. A non-zero ALT of a result edge,
points  at  an  edge  of one operand that was buried inside the solid
body of the other operand, and is thus called an interior edge.
ALT of all faces of the result points at the corresponding face of
one of the operands.

/
SUBR(WITH3D,FACE,X,Y,Z)		;TEST FOR LOCUS WITHIN FACE 3D.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
	
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
	LAC F,FACE
	MOVM 1,AA(F)
	MOVM 2,BB(F)
	MOVM 3,CC(F)
	MOVEI C0↔CAMG 1,2↔GO[
	MOVEI C1↔CAMG 2,3↔MOVEI C2↔GO .+3]
		CAMG 1,3↔MOVEI C2↔DAP CASE

;FIRST EDGE OF THE FACE.
	SETOM FLG
	PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
	LAC DX2,XWC(V)↔FSB DX2,X
	LAC DY2,YWC(V)↔FSB DY2,Y
	LAC DZ2,ZWC(V)↔FSB DZ2,Z

L1:	LAC DX1,DX2
	LAC DY1,DY2
	LAC DZ1,DZ2
	LAC Q1,Q2

;NEXT EDGE OF THE FACE.
	SETQ(V,{VCCW,E,F})
	SETQ(E,{ECCW,E,F})
	LAC DX2,XWC(V)↔FSB DX2,X
	LAC DY2,YWC(V)↔FSB DY2,Y
	LAC DZ2,ZWC(V)↔FSB DZ2,Z

;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.

CASE:	GO
C0:	LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1:	LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2:	LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3:	FSB 0,1↔DAC Q2
	JUMPE 0,L3		;LOCUS IS ON A FUCKING EDGE !

;DETECT SIGN CHANGE.

	AOJE FLG,L2		;JUMP ON FIRST TIME THRU.
	XOR Q1↔JUMPL POP4J.	;NO SKIP RETURN FALSE.
L2:	CAME E,E0↔GO L1
	AOS(P)↔POP4J		;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3:	LAC DX1↔FMP DX2			;COSINE.
	LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
	LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
	SKIPGE↔AOS(P)↔POP4J		;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(COMPFE,FACE,EDGE)		;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
    V2 ← PVT    ⊗	Q2 < K	   ABOVE F,
                | ENEW
            ____|_____________________
           /    |                    /
          /     ⊗ V      FACE F     /
         /_________________________/
		|
		|  E
    V1 ← NVT	⊗ 	Q1 > K     BELOW-F.
	ACCUMULATORS{X,Y,Z,V1,V2,E,F}

;CHECK ARGUMENTS FOR FRESHNESS.
	LAC E,EDGE↔LAC F,FACE
	NVT V1,E↔PVT V2,E
	QFACE 1,V1↔CAMN 1,F↔POP0J
	QFACE 1,V2↔CAMN 1,F↔POP0J

;DIRECTED DISTANCE V1 FROM FACE.
	LAC 0,AA(F)↔FMP 0,XWC(V1)
	LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
	LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#

;DIRECTED DISTANCE V2 FROM FACE.
	LAC 0,AA(F)↔FMP 0,XWC(V2)
	LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
	LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#

;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
	LAC KK(F)
	CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
	CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
	FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
	FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1

;SOLVE FOR PLANE PIERCING LOCUS.
	LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
	LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
	LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
	CALL(WITH3D,F,X,Y,Z)↔POP0J
	LAC E,EDGE↔LAC F,FACE↔ADD P,[XWD 4,4]

;MAKE FACE PIERCING POINT.
	LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
	CALL(ESPLIT,E)↔MARK 1,SURBIT
	POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
	QFACE. 0,1↔LAC 2,EDGE↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBN(OTHERV,FACE,VERTEX)	;FETCH OTHER VERTEX PIERCING FACE.
COMMENT ;-----------------------------------------------------------

  F1 PIERCES F2 AT V2 CASE.	  F2 PIERCES F1 AT V2 CASE.
            ______________                ________
           |              |              |        |
           |   F2         |              |   F2   |
     ______|.........     |        ______|........|_____
    |      ↓        .     |       |      ↓        ↓     |
    | F1   ⊗V1      ⊗V2   |       | F1   ⊗V1      ⊗V2   |
    |_______________↑     |       |_____________________|
           |              |              |        |
           |______________|              |________|     ;

	ACCUMULATORS{F1,F2,V1,E,E0}
	SAVAC(6)
	LAC F2,FACE
	LAC V1,VERTEX
	QFACE F1,V1

;DOES F1 PIERCE F2 AT V2.
	PED E,F1↔DAC E,E0
L1:	CALL(VCCW,E,F1)
	QFACE 0,1
	CAMN 0,F2↔GO L4
	SETQ(E,{ECCW,E,F1})
	CAME E,E0↔GO L1

;DOES F2 PIERCE F1 AT V2.
	PED E,F2↔DAC E,E0
L2:	CALL(VCCW,E,F2)
	CAMN 1,V1↔GO .+4
	QFACE 0,1
	CAMN 0,F1↔GO L4
	SETQ(E,{ECCW,E,F2})
	CAME E,E0↔GO L2
	FATAL(OTHERV)
L4:	GETAC(6)↔POP2J
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBN(SOLANG,VERTEX)	DIUHEDRAL ANGLE AT A PIERCING VERTEX.
COMMENT .-----------------------------------------------------------.
	EXTERN ACOS,DISTANCE,TWOPI
	ACCUMULATORS{F,V}

	LAC 1,VERTEX↔DAC 1,V0
	PED 1,1↔DAC 1,E
	SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV,F1,V0})
	SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})

	CALL(DISTANCE,V1,V0)↔PUSH P,1		;L1
	CALL(DISTANCE,V2,V0)↔PUSH P,1		;L2
	CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1	;L3

;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
	POP P,2↔POP P,3
	LAC 2↔FMPR 3↔FSC 1
	FMPR 2,2↔FMPR 3,3
	FADR 1,2↔FADR 1,3
	FDVR 1,0
	CALL(ACOS,1)↔PUSH P,1

	LAC V,V2↔LAC F,F1
	LAC 0,XWC(V)↔FMPR 0,AA(F)
	LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
	LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
	POP P,1
	CAML KK(F)↔POP1J↔MOVNS 1
	FADR TWOPI↔POP1J	;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
SUBN(KLSURV,B)		KILL SURFACE VERTICES OF A BODY.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{V}
	LAC V,B
L:	NVT V,V↔CAMN V,B↔POP1J		;SCAN FOR...
	TEST V,SURBIT↔GO L		;PIERCING VERTICES.
	NVT V,V↔PUSH P,V↔PVT V,V	;SAVE NEXT...
	CALL(KLEV↑,V)↔POP P,V		;KILL THIS VERTEX.
	GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------

SUBN(OKSURV,VERTEX)	MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{V}
	LAC V,VERTEX↔PED 1,V		;FIRST EDGE.
	PFACE 1,1↔DAC 1,FACE#		;FACE BELONGINF TO V.
	QFACE 1,V↔DAC 1,OLDQF#		;FACE PIERCED BY V.
L:	MARK V,OKBIT↔PUSH P,V
	CALL(OTHERV,FACE,V)		;FOLLOW SURV LOOP ACROSS.
	POP P,V
	CAMN 1,VERTEX↔GO[
	SETZ↔ALT2. 0,V↔POP1J]		;NIL AT END OF LIST.
	ALT2. 1,V↔DAC 1,V		;OLDE V POINTS AT NEW V.
	QFACE 0,V↔LAC 1,FACE		;NEXT FACE.
	CAME 0,OLDQF↔LAC 1,OLDQF
	DAC 0,OLDQF↔PED 0,V
	SETQ(FACE,{OTHER,0,1})
	GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------


SUBN(GETSURV,B)	   GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT .-----------------------------------------------------------.
	LAC 1,B
L:	NVT 1,1
	CAMN 1,B↔GO[AOS(P)↔POP1J]
	TEST 1,SURBIT↔GO L
	TESTZ 1,OKBIT↔GO L
	POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBR(BIN,B1,B2)		COMPUTE BODY OF INTERSECTION.
COMMENT .-----------------------------------------------------------.
L0:	LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
	LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1)
	LAC 1,B1↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔SETZM ZPP(1)↔GO .-5
	LAC 1,B2↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔SETZM ZPP(1)↔GO .-5

;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
;THIS N SQUARED PROCESS MAY SOMEDAY BE REPLACED WITH AN OCCULT MODE.
	LAC 1,B2
L1:	PED 1,1↔TEST 1,EBIT↔GO L2-1
	LAC 2,B1↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
	CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L1

	LAC 1,B1
L2:	PED 1,1↔TEST 1,EBIT↔GO L3
	LAC 2,B2↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
	CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L2

L3:	CALL(GETSURV,B1)↔GO L4
	CALL(GETSURV,B2)↔GO L4
	GO L5

L4:	CALL(QHOLE,1)		;CHECK OUT A POTENTIAL HOLE.
	GO L3			;NO HOLE YET.
	CALL(KLSURV,B1)		;HOLE FACE WAS PYRAMID'ED.
	CALL(KLSURV,B2)		;START OVER.
	GO L0
L5:	CALL(MKB,[0])↔DAC 1,BODY0
	CALL(MKFRAME)↔LAC 2,BODY0↔ALT2. 1,2
	LAC 1,B1
	NVT 1,1↔TESTZ 1,VBIT↔GO[
		TEST 1,SURBIT↔GO .-3
		ALT 0,1↔SKIPE↔GO .-3
		CALL(MKSURF,1,1)
		POP P,1↔GO .-3]
	LAC 1,B2
	NVT 1,1↔TESTZ 1,VBIT↔GO[
		TEST 1,SURBIT↔GO .-3
		ALT 0,1↔SKIPE↔GO .-3
		CALL(MKSURF,1,1)
		POP P,1↔GO .-3]
L6:	CALL(FIXUP1)
	LAC 1,BODY0
	POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
BODY0:	0

SUBR(BUN,B1,B2)			BODY UNION.
COMMENT .-----------------------------------------------------------.
	CALL(EVERT,B2)↔CALL(EVERT,B1)
	CALL(BIN,B1,B2)
	PUSHP 1↔CALL(EVERT,1)		;SAVE RESULT.
	CALL(EVERT,B2)↔CALL(EVERT,B1)	;STATUS QUO ANTE.
	POPP 1↔POP2J			;RETURN RESULT.
ENDR BUN;3/10/73(BGB)------------------------------------------------

SUBR(BSUB,B1,B2)		BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT .-----------------------------------------------------------.
	CALL(EVERT,B2)
	CALL(BIN,B1,B2)↔PUSHP 1
	CALL(EVERT,B2)↔POPP 1
	POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBN(MKSURF,VERTEX)	MAKE SURFACE EDGES AND VERTICES.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{A,V1,V2,F,QF,FLG}
	LAC V2,VERTEX↔PED 1,V2
	SETZM FLG		;FOR ORIENTING THE FACES OF NEW EDGES.
	SETQ(F,{FCCW,1,V2})		;FACE BELONGING TO V.
	QFACE QF,V2			;FACE PIERCED BY V.
	CALL(MKV,BODY0)↔JALTV(V2,1)	;MAKE FIRST SURFACE VERTEX.
L1:	LAC V1,V2
	SETQ(V2,{OTHERV,F,V1})		;FOLLOW SURFACE LOOP.
	CALL(ETRACE,V2)
	CAMN V2,VERTEX↔GO L2
	CALL(MKV,BODY0)↔JALTV(V2,1)	;MAKE SURFACE VERTEX.
L2:	SETQ(A,{MKE,BODY0})		;MAKE SURFACE EDGE.
	ALT 1,V1↔NVT. 1,A↔PED. A,1	;LINK A TO ITS VERTICES.
	ALT 1,V2↔PVT. 1,A↔NED. A,1
	NFACE. QF,A↔PFACE. F,A		;LINK A TO ALEIN FACES.
	SKIPE FLG↔MOVSS 1(A)
	CAMN V2,VERTEX↔POP1J		;TEST FOR END OF PHASE-1.
	QFACE 0,V2↔LAC 1,F		;NEXT FACE.
	CAMN 0,QF↔GO .+3
	LAC 1,QF↔SETCMM FLG
	DAC 0,QF↔PED 0,V2		;NEW PIERCED FACE.
	SETQ(F,{OTHER,0,1})↔GO L1
ENDR MKSURF;5/9/74(BGB)----------------------------------------------

SUBN(ETRACE,VERTEX)		;TRACE INTERIOR EDGES & VERTICES.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{E,E0,V}
	SAVAC(4)
	LAC V,VERTEX↔PED E,V↔GO L2	;STARTING FROM A SURV.
L0:	CALL(MKV,BODY0)↔JALTV(V,1)	;MAKE INTERIOR VERTEX.
L1:	PED E,V↔DAC E,E0
L2:	ALT 1,E↔JUMPN 1,L3		;IS EDGE ALREADY TRACED ?
	CALL(MKE,BODY0)↔JALT(1,E)	;MAKE INTERIOR EDGE.
	LAC 1(E)↔DAC 1(1)		;COPY THE FACE LINKS.
L3:	CALL(OTHER,E,V)
	TESTZ 1,SURBIT↔GO L4		;DON'T TRACE SURV'S.
	ALT 0,1↔JUMPN 0,L4		;IS VERTEX ALREADY TRACED ?
	ALT2. V,1↔LAC V,1↔GO L0		;PUSH VERTEX 
L4:	CAMN V,VERTEX↔GO L5
	SETQ(E,{ECCW,E,V})
	CAME E,E0↔GO L2
	ALT2 V,V↔SKIPE V↔GO L1		;POP VERTEX
L5:	GETAC(4)↔POP1J
ENDR ETRACE;5/9/74(BGB)----------------------------------------------
SUBN(FIXUP1)
COMMENT .-----------------------------------------------------------.
;FIX UP VERTEX AND WING POINTERS OF ALL NON-SURFACE EDGES.
	ACCUMULATORS{A,E,V,Q}
	LAC A,BODY0
L1:	PED A,A↔CAMN A,BODY0↔GO L2-1	;POP0J
	ALT E,A↔JUMPE E,L1		;SURFACE EDGES HAVE ALT ZERO.
	PVT V,E↔  ALT V,V↔PVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
	NVT V,E↔  ALT V,V↔NVT. V,A↔PED 0,V↔SKIPN↔PED. A,V
	NCW Q,E↔ ALT Q,Q↔NCW.  Q,A
	PCW Q,E↔ ALT Q,Q↔PCW.  Q,A
	NCCW Q,E↔ALT Q,Q↔NCCW. Q,A
	PCCW Q,E↔ALT Q,Q↔PCCW. Q,A↔GO L1
;....................................................................
;WING TOGETHER THE SURFACE VERTEX TRIHEDRAL CORNERS.
	ACCUMULATORS{U,V,A1,A2,A3}
	LAC U,BODY0
L2:	PVT U,U↔CAMN U,BODY0↔GO L3-1	;POP0J
	ALT V,U
	TEST V,SURBIT↔GO L2
	PED 1,V↔ALT A1,1
	PED A2,U↔NED A3,U↔HRRZS 2(U)
	CALL(WING,A1,A2)
	CALL(WING,A1,A3)
	CALL(WING,A2,A3)↔GO L2
;....................................................................
;REPLACE ALEIN FACES WITH NATIVE FACES.
	ACCUMULATORS{A,A0,E,F1,F2}
	LAC A,BODY0
L3:	PED A,A↔CAMN A,BODY0↔POP0J
	SETZ↔ALT. 0,A			;CLEAR EDGE ALT LINKS OF BODY0.
	PFACE F1,A↔PUSHJ P,L4
	NFACE F1,A↔PUSHJ P,L4↔GO L3
L4:	PED E,F1↔CCW 1,E		;SUB-SUBROUTINE TO REPLACE A FACE.
	CAMN 1,BODY0↔POPJ P,
	SETQ(F2,{MKF,BODY0})↔PED. A,F2
	DAC A,A0
L5:	CALL(ECCW,A,F1)
	PFACE 0,A↔CAMN 0,F1↔PFACE. F2,A
	NFACE 0,A↔CAMN 0,F1↔NFACE. F2,A
	DAC 1,A↔CAME A,A0↔GO L5↔POPJ P,
ENDR FIXUP1;---------------------------------------------------------
SUBN(QHOLE,VERTEX)	 DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{V}
	CALL(OKSURV,VERTEX)

;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
	LAC V,VERTEX
	QFACE 1,V↔DAC 1,QF#
L1:	ALT2 V,V↔JUMPE V,L2
	QFACE 0,V↔CAME 0,QF↔POP1J	;EXIT NO HOLE.
	GO L1
L2:	SETZM A#↔SETZM N#↔SETZM X#↔SETZM Y#↔SETZM Z#

;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
	LAC V,VERTEX
L3:	LAC XWC(V)↔FADRM X
	LAC YWC(V)↔FADRM Y
	LAC ZWC(V)↔FADRM Z
	AOS N↔PUSH P,V
	CALL(SOLANG,V)↔FADRM 1,A
	POP P,V↔ALT2 V,V
	SKIPE V↔GO L3

	LAC 0,N↔FLOAT↔DAC 0,N
	FSBRI(2.0)↔FMPR PI↑↔FSBR A
L4:	MOVMS↔CAMGE[0.01]↔POP1J		;EXIT - NO HOLE.
	CALL(PYRAMID↑,QF)
	LAC X↔FDVR N↔DAC XWC(1)
	LAC Y↔FDVR N↔DAC YWC(1)
	LAC Z↔FDVR N↔DAC ZWC(1)
	PED 2,1↔DAC 2,3↔DAC 1,4
L5:	MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
	AOS(P)↔POP1J			;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(MKCVEX)F 		MAKE CONVEX.
COMMENT .-----------------------------------------------------------.
	EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
	ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}

;GET EXTREMA VERTICES.
MKCVX.:
	LAC F,-1(P)↔DAC F,FACE1
	TEST F,BBIT↔GO L0
L00:	PFACE F,F↔CAMN F,-1(P)↔POP1J
	PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0:	PED E0,F↔DAC E0,EDGE0
	MOVEI CNT,1
	MOVSI YMAX,400000
	MOVSI XMAX,400000
	SETCM YMIN,YMAX
	SETCM XMIN,XMAX

L1:	SETQ(V,{VCCW,E0,F})
	CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
	CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
	CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
	CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
	SETQ(E0,{ECCW,E0,F})
	CAME E0,EDGE0↔AOJA CNT,L1

;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B:	CAIG CNT,3↔POP1J
	GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:	
	LAC V,-1(P)↔DAC V,VERT2
	SETQ(EDGE1,{ECCW,VERT2,FACE1})
	PVT 0,1↔CAMN 0,V↔GO .+3
	CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
	SETQ(EDGE3,{ECW,VERT2,FACE1})
	PVT 0,1↔CAMN 0,V↔GO .+3
	CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
	CALL(ECOEF,EDGE1)
	CALL(ECOEF,EDGE3)
	LAC 2,EDGE1↔LAC 3,EDGE3
	LAC 1,AA(2)↔FMPR 1,AA(3)
	LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
	LAC 0,-1(P)
	SUB P,[2(2)]↔GO @2(P)			;"POP1J"
;--------------------------------------------------------------------
L6:	CALL(,N,S,E,W)
	MOVSI(<-2.0>)↔DAC TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5,VERT0)

	SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
	MARK 1,DARKEN+NSHARP
	NFACE 1,1↔DAC 1,FACE2
	CALL(FACOEF↑,FACE2)
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
	HRLOI 377777↔DAC QMIN↔SETZM VERT4		;INIT FOR CLOSEST VIOLATOR.
	LAC EDGE2↔DAC EDGE0			;INIT FOR FACE1 PERIMETER SCAN.

L2:	SETQ(EDGE0,{ECCW,EDGE0,FACE1})
	SETQ(VERT0,{VCCW,EDGE0,FACE1})
	CAMN 1,VERT1↔GO L3

;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
	CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
	GO L2	;VERTEX IS NOT WITHIN THE TRIANGLE.

;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
	CALL(DISTANCE↑,VERT0,VERT2)
	CAML 1,QMIN↔GO L2
	DAC 1,QMIN
	LAC VERT0↔DAC VERT4
	GO L2			;CONTINUE THE SCAN.

;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3:	SKIPE VERT4↔GO L4
	GO MKCVX.

;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4:	CALL(KLFE,EDGE2)
	CALL(MKFE,VERT2,FACE1,VERT4)
	MARK 1,DARKEN
	NFACE 1,1	;START WORKING ON THE NEW FACE.
	CALL(MKCVEX,1)
	GO MKCVX.	;CONTINUE WORKING ON THE OLDE FACE.

DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL:	0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY)	;REMOVE UNNECESSARY EDGES.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{F1,F2,E1} 
;Calculate face co-efficients for each face.
	CALL(FACOEF↑,BODY)
;Go backwords  thru ring  of edges  killing any  darkened edges  with
;co-planar faces.
	LAC E1,BODY
LOOP:	NED E1,E1
	TEST E1,EBIT↔POP1J
	PFACE F1,E1↔NFACE F2,E1
;Compare face co-efficients.  Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
	FOR @` I ε {XYZ}
<	LAC I`WC(F1)↔FSBR I`WC(F2)
	MOVM 0,0↔CAML 0,[0.000001]↔GO LOOP
>	LAC 0,E1 
;They're co-planar,  now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
	MARK E1,DARKEN
	PVT 1,E1↔DAC 1,V1
	NVT 1,E1↔DAC 1,V2
;Do PVT
	NCCW 1,E1↔SETQ V3,{OTHER↑,1,V1}
	PCW 1,E1 ↔SETQ V4,{OTHER↑,1,V1}
	PUSH P,E1
	CALL(ANGL3V↑,V3,V1,V2)	;ANGL3V appears to return a value < π
	MOVEM 1,T1 		;so both angles must be summed, instead
	CALL(ANGL3V↑,V2,V1,V4)	;of just angle between CW and CCW edges.
	FADR 1,T1
	POP P,E1
	CAML 1,PI↑↔GO LOOP
;Do NVT
	PCCW 1,E1↔SETQ V3,{OTHER↑,1,V2}
	NCW 1,E1 ↔SETQ V4,{OTHER↑,1,V2}
	PUSH P,E1
	CALL(ANGL3V↑,V3,V2,V1)↔DAC 1,T1
	CALL(ANGL3V↑,V1,V2,V4)↔FADR 1,T1
	POP P,E1
	CAML 1,PI↑↔GO LOOP
;We found an unneeded edge, kill it!
	NED 0,E1
	PUSH P,0↔CALL(KLFE↑,E1)↔POP P,E1
	GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
SUBR(MKBUCK,BODY)		;MAKE BUCKET CUBE.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}

;FIND COORDINATE EXTREMA.
	HRLOI XLO,377777↔HRLZI 400000
	HRLOI YLO,377777↔HRLZI 400000
	HRLOI ZLO,377777↔HRLZI 400000
	LAC B,BODY↔LAC V,B

L1:	PVT V,V↔CAMN V,B↔GO L2
	CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
	CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
	CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
	GO L1

;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2:	PUSH P,[0]
	DAC XHI,0↔FSBR XHI,XLO↔FADR XLO,0↔FSC XLO,-1↔PUSH P,XLO
	DAC YHI,0↔FSBR YHI,YLO↔FADR YLO,0↔FSC YLO,-1↔PUSH P,YLO
	DAC ZHI,0↔FSBR ZHI,ZLO↔FADR ZLO,0↔FSC ZLO,-1↔PUSH P,ZLO
	CALL(MKCUBE↑,XHI,YHI,ZHI)
	DAC 1,BUCK#↔DAC 1,-3(P)			;PLACE BUCKET IN PDL.
	CALL(TRANSLATE↑);"B,XLO,YLO,ZLO)"	;POSITION THE BUCKET.
	LAC 1,BUCK↔POP1J
ENDR MKBUCK;1/15/74(BGB)---------------------------------------------

	DECLARE{ZCUT,LIST1,FSET1,ELIST1,ELIST2,BSET1}
SUBR(ECUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
	SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
	CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
	CALL(VMARK,B)↔SETZM ELIST2↔SETOM CUTFLG
	CALL(FECUT,B)
	CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
	CALL(KLNODE↑,FRM)↔POP4J
ENDR ECUT;3/6/74(BGB)------------------------------------------------

SUBR(FCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
	SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
	CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
	CALL(VMARK,B)↔SETZM ELIST2↔SETZM CUTFLG
	CALL(FECUT,B)
	CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
	CALL(KLNODE↑,FRM)↔POP4J
ENDR FCUT;3/6/74(BGB)------------------------------------------------

SUBN(VMARK,BODY)	    ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{V}

;CLEAR THE NZ AND PZ BITS OF ALL THE VERTICES.
	SETZM PZCNT↔SETZM NZCNT
	MOVEI PZ+NZ↔LAC 1,BODY
	ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3

;MARK THE VERTICES AS EITHER ABOVE OR BELOW ZERO XWC.
	LAC V,BODY
L1:	PVT V,V↔CAMN V,BODY↔POP1J
	SKIPGE XWC(V)↔GO L2
	MARK V,PZ↔AOS PZCNT↔GO L1		;POSITIVE.
L2:	MARK V,NZ↔AOS NZCNT↔GO L1		;NEGATIVE.

ENDR VMARK;1/11/74(BGB)---------------------------------------------

	DECLARE{PZCNT,NZCNT,CUTFLG,FRM}
SUBR(BCUT,B,DX,DY,DZ)
COMMENT .-----------------------------------------------------------.
	SETQ(FRM,{MKQFRM↑,DX,DY,DZ})
	CALL(INTRAN↑,FRM)↔CALL(APTRAN↑,B,FRM)
	CALL(VMARK,B)↔SETZM ELIST2
	MOVEI 1↔DAC CUTFLG↔CALL(FECUT,B)	;BODY CUT +1.

L1:	SKIPN 2,ELIST2↔GO[
	  CALL(INTRAN↑,FRM)
	  CALL(APTRAN↑,B,FRM)
	  POP4J]
	ALT2 1,2↔DAC 1,ELIST2↔DAC 2,ELIST1

;KILL THE TIES THAT BIND  -  MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L2:	SKIPN 2,ELIST1↔GO L3
	ALT 1,2↔DAC 1,ELIST1
	PFACE 0,2↔DAC 0,FACE1
	SETQ(FACE2,{KLFE,2})
	GO L2

L3:	LAC 1,FACE1↔LAC 2,FACE2		;LINK TWO NEW FACES.
	MARK 1,TMPBIT↔MARK 2,TMPBIT
	ALT. 1,2↔ALT. 2,1
	LAC 1,FACE1↔PED 1,1↔CCW 1,1↔CAME 1,B↔GO[CALL(BATT↑,1,B)↔GO .+1]
	LAC 2,FACE2↔PED 2,2↔CCW 2,2↔CAME 2,B↔GO[CALL(BATT↑,2,B)↔GO .+1]
	GO L1

DECLARE{EDGE,FACE1,FACE2}
ENDR BCUT;3/6/74(BGB)------------------------------------------------
SUBN(FECUT,BODY)	    ;FACE EDGE CUTTING.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{V2,V1,DX,DY,DZ}

;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
	LAC 1,BODY↔DAC 1,EDGE#
L0:	LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE	;ADVANCE ALONG EDGE RING.
	CAMN 1,BODY↔POP1J		;TEST FOR END OF EDGE RING.
	PVT V1,1↔NVT V2,1		;GET VERTICES.
	LAC(V1)↔EQV(V2)
	TESTZ(,PZ+NZ)↔GO L0  		;TEST FOR EDGE CROSSING.

;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
	SETOM FLAG			;FIRST TIME THRU FLAG -1.
	SETZM ELIST1↔LAC 1,EDGE		;LIST OF VERY SHORT EDGES.
	DAC 1,E↔NVT 2,1↔TEST 2,PZ
	GO[CALL(INVERT,E)↔GO .+1]	;FORCE NVT(E) INTO PZ HALF-SPACE.
	LAC 1,E↔NFACE 1,1
	DAC 1,F0↔DAC 1,F		;FIRST FACE.

;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1:	LAC 1,E
	NVT V1,1↔PVT V2,1
	PUSH P,V2↔PUSH P,V1		;SAVE OLDE VERTICES.
	TEST V1,PZ↔GO[
	CALL(INVERT,E)↔GO .+1]		;FORCE NVT(E) INTO PZZ.
	SETQ(U2,{ESPLIT,E})
;	MARK 1,TMPBIT
	MARK 1,PZ↔PED 1,1
	SKIPLE CUTFLG↔GO[
	LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1
	SETQ(UU2,{ESPLIT,ELIST1})
;	MARK 1,TMPBIT
	MARK 1,NZ↔GO .+1]

;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
	POP P,V1↔POP P,V2			;RESTORE OLDE VERTICES.
	LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
	LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
	LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
	MOVN 0,XWC(V1)↔FDVR 0,DX↔LAC 2,U2
	FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
	FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)

;FIRST TIME ONLY.
	AOSG FLAG↔GO[
	LAC U2↔DAC U0
	LAC UU2↔DAC UU0
	GO L2]

;SPLIT FACES.
	SKIPL CUTFLG↔GO[
	CALL(MKFE,U2,F,U1)↔ ;MARK 1,TMPBIT
	NFACE 1,1
	SKIPE CUTFLG↔GO[
	CALL(MKFE,UU2,1,UU1)↔ ;MARK 1,TMPBIT
	GO .+1]↔GO .+1]

;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2:	LAC U2↔DAC U1
	LAC UU2↔DAC UU1
	SETQ(F,{OTHER,E,F})
	CAMN 1,F0↔GO L4

L3:	SETQ(E,{ECCW,E,F})
	CALL(VCCW,E,F)
	TEST 1,NZ↔GO L3
	GO L1

;DOUBLE CUT LAST (FIRST) FACE.
L4:	SKIPGE CUTFLG↔GO L0
	CALL(MKFE,U0,F,U1)↔ ;MARK 1,TMPBIT
	NFACE 1,1
	SKIPG CUTFLG↔GO L0
	CALL(MKFE,UU0,1,UU1)↔ ;MARK 1,TMPBIT
	LAC 1,ELIST1↔LAC 2,ELIST2
	ALT2. 2,1
	DAC 1,ELIST2↔SETZM ELIST1
	GO L0

DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
END